home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch3 / DevInfo.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-01  |  15.0 KB  |  341 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDevInfo 
  3.    Caption         =   "DevInfo"
  4.    ClientHeight    =   3630
  5.    ClientLeft      =   1320
  6.    ClientTop       =   1035
  7.    ClientWidth     =   5055
  8.    LinkTopic       =   "PalInfo"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   242
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   337
  13.    Begin VB.TextBox txtInfo 
  14.       Height          =   2415
  15.       Left            =   120
  16.       MultiLine       =   -1  'True
  17.       ScrollBars      =   2  'Vertical
  18.       TabIndex        =   0
  19.       Top             =   120
  20.       Width           =   3495
  21.    End
  22. Attribute VB_Name = "frmDevInfo"
  23. Attribute VB_GlobalNameSpace = False
  24. Attribute VB_Creatable = False
  25. Attribute VB_PredeclaredId = True
  26. Attribute VB_Exposed = False
  27. Option Explicit
  28. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  29. Private Const TECHNOLOGY = 2     ' Device type.
  30. Private Const RASTERCAPS = 38    ' Raster capabilities.
  31. Private Const NUMRESERVED = 106  ' # reserved entries in palette.
  32. Private Const SIZEPALETTE = 104  ' Size of system palette.
  33. Private Const HORZSIZE = 4       ' Horizontal size in millimeters.
  34. Private Const VERTSIZE = 6       ' Vertical size in millimeters.
  35. Private Const HORZRES = 8        ' Horizontal width in pixels.
  36. Private Const VERTRES = 10       ' Vertical width in pixels.
  37. Private Const LOGPIXELSX = 88    ' Logical pixels/inch horizontally.
  38. Private Const LOGPIXELSY = 90    ' Logical pixels/inch horizontally.
  39. Private Const BITSPIXEL = 12     ' # bits per pixel.
  40. Private Const PLANES = 14        ' # color planes.
  41. Private Const NUMBRUSHES = 16    ' # brushes.
  42. Private Const NUMCOLORS = 24     ' # colors in device color table.
  43. Private Const NUMFONTS = 22      ' # fonts.
  44. Private Const NUMMARKERS = 20    ' # markers.
  45. Private Const NUMPENS = 18       ' # pens.
  46. Private Const COLORRES = 108     ' Color resolution.
  47. Private Const CURVECAPS = 28     ' Curve capabilities.
  48. Private Const LINECAPS = 30      ' Line capabilities.
  49. Private Const POLYGONALCAPS = 32 ' Polygon capabilities.
  50. Private Const TEXTCAPS = 34      ' Text capabilities.
  51. ' TECHNOLOGY values.
  52. Private Const DT_PLOTTER = 0     ' Vector plotter.
  53. Private Const DT_RASDISPLAY = 1  ' Raster display.
  54. Private Const DT_RASPRINTER = 2  ' Raster printer.
  55. Private Const DT_RASCAMERA = 3   ' Raster camera.
  56. Private Const DT_CHARSTREAM = 4  ' Character-stream, PLP.
  57. Private Const DT_METAFILE = 5    ' Metafile, VDM.
  58. Private Const DT_DISPFILE = 6    ' Display-file.
  59. ' RASTERCAPS values.
  60. Private Const RC_BITBLT = 1          ' Can BLT.
  61. Private Const RC_BANDING = 2         ' Supports banding support.
  62. Private Const RC_SCALING = 4         ' Supports scaling support.
  63. Private Const RC_BITMAP64 = 8        ' Supports >64K bitmaps.
  64. Private Const RC_GDI20_OUTPUT = &H10 ' Has 2.0 output calls.
  65. Private Const RC_DI_BITMAP = &H80    ' Supports DIB to memory.
  66. Private Const RC_PALETTE = &H100     ' Supports palettes.
  67. Private Const RC_DIBTODEV = &H200    ' Supports DIBitsToDevice.
  68. Private Const RC_BIGFONT = &H400     ' Supports >64K fonts.
  69. Private Const RC_STRETCHBLT = &H800  ' Supports StretchBlt.
  70. Private Const RC_FLOODFILL = &H1000  ' Supports FloodFill.
  71. Private Const RC_STRETCHDIB = &H2000 ' Supports StretchDIBits.
  72. ' CURVECAP values.
  73. Private Const CC_CHORD = 4       ' Chords.
  74. Private Const CC_CIRCLES = 1     ' Circles.
  75. Private Const CC_ELLIPSES = 8    ' Ellipses.
  76. Private Const CC_INTERIORS = 128 ' Can do interiors.
  77. Private Const CC_PIE = 2         ' Pie slices.
  78. Private Const CC_STYLED = 32     ' Styled lines.
  79. Private Const CC_WIDE = 16       ' Wide lines.
  80. Private Const CC_WIDESTYLED = 64 ' Wide styled lines.
  81. ' LINECAPS values.
  82. Private Const LC_INTERIORS = 128 ' Interiors.
  83. Private Const LC_MARKER = 4      ' Markers.
  84. Private Const LC_POLYLINE = 2    ' Polylines.
  85. Private Const LC_POLYMARKER = 8  ' Polymarkers.
  86. Private Const LC_STYLED = 32     ' Styled lines.
  87. Private Const LC_WIDE = 16       ' Wide lines.
  88. Private Const LC_WIDESTYLED = 64 ' Wide styled lines.
  89. ' POLYGONCAPS values.
  90. Private Const PC_INTERIORS = 128 ' Interiors.
  91. Private Const PC_POLYGON = 1     ' Alternate filled polygons.
  92. Private Const PC_RECTANGLE = 2   ' Rectangles.
  93. Private Const PC_SCANLINE = 8    ' Scanlines.
  94. Private Const PC_STYLED = 32     ' Styled borders.
  95. Private Const PC_WIDE = 16       ' Wide borders.
  96. Private Const PC_WIDESTYLED = 64 ' Wide styled borders.
  97. Private Const PC_WINDPOLYGON = 4 ' Winding number filled polygons.
  98. ' TEXTCAPS values.
  99. Private Const TC_CP_STROKE = &H4     ' Stroke clip precision.
  100. Private Const TC_CR_90 = &H8         ' Characters rotated 90 degrees.
  101. Private Const TC_CR_ANY = &H10       ' Characters rotated by any angle.
  102. Private Const TC_EA_DOUBLE = &H200   ' Bold.
  103. Private Const TC_IA_ABLE = &H400     ' Italics.
  104. Private Const TC_OP_CHARACTER = &H1  ' Character output precision.
  105. Private Const TC_OP_STROKE = &H2     ' Stroke output precision.
  106. Private Const TC_RA_ABLE = &H2000    ' Raster fonts.
  107. Private Const TC_SA_CONTIN = &H100   ' Continuously scaled fonts.
  108. Private Const TC_SA_DOUBLE = &H40    ' Fonts scaled by a double.
  109. Private Const TC_SA_INTEGER = &H80   ' Fonts scaled by an integer.
  110. Private Const TC_SF_X_YINDEP = &H20  ' Fonts scaled in the X and Y directions independently.
  111. Private Const TC_SO_ABLE = &H1000    ' Strikeout.
  112. Private Const TC_UA_ABLE = &H800     ' Underline.
  113. Private Const TC_VA_ABLE = &H4000    ' Vector fonts.
  114. ' Get the device information.
  115. Private Sub Form_Load()
  116. Dim txt As String
  117. Dim sys_pal_size As Integer
  118. Dim num_static As Integer
  119. Dim clrres As Integer
  120. Dim rascaps As Integer
  121. Dim curves As Integer
  122. Dim lines As Integer
  123. Dim poly As Integer
  124. Dim text As Integer
  125.     ' Get the device type.
  126.     txt = "This device is a "
  127.     Select Case GetDeviceCaps(hdc, TECHNOLOGY)
  128.         Case DT_PLOTTER
  129.             txt = txt & "vector plotter"
  130.         Case DT_RASDISPLAY
  131.             txt = txt & "raster display"
  132.         Case DT_RASPRINTER
  133.             txt = txt & "raster printer"
  134.         Case DT_RASCAMERA
  135.             txt = txt & "raster camera"
  136.         Case DT_CHARSTREAM
  137.             txt = txt & "character-stream, PLP"
  138.         Case DT_METAFILE
  139.             txt = txt & "metafile, VDM"
  140.         Case DT_DISPFILE
  141.             txt = txt & "display-file"
  142.     End Select
  143.     txt = txt & "." & vbCrLf
  144.     ' Get the display size in millimeters.
  145.     txt = txt & "The display is" & _
  146.         Str$(GetDeviceCaps(hdc, HORZSIZE)) & "x" & _
  147.         Format$(GetDeviceCaps(hdc, VERTSIZE))
  148.     ' Get the display size in pixels.
  149.     txt = txt & " millimeters or" & _
  150.         Str$(GetDeviceCaps(hdc, HORZRES)) & "x" & _
  151.         Format$(GetDeviceCaps(hdc, VERTRES)) & _
  152.         " pixels." & vbCrLf
  153.     ' Get logical pixels per inch.
  154.     txt = txt & "Horizontal pixels per inch:" & _
  155.         Str$(GetDeviceCaps(hdc, LOGPIXELSX)) & _
  156.         vbCrLf
  157.     txt = txt & "Vertical pixels per inch:" & _
  158.         Str$(GetDeviceCaps(hdc, LOGPIXELSY)) & _
  159.         vbCrLf
  160.         
  161.     ' Get color and tool information.
  162.     txt = txt & "Bits per pixel:" & _
  163.         Str$(GetDeviceCaps(hdc, BITSPIXEL)) & _
  164.         "." & vbCrLf
  165.     txt = txt & "Color planes:" & _
  166.         Str$(GetDeviceCaps(hdc, PLANES)) & _
  167.         "." & vbCrLf
  168.     txt = txt & "Device brushes:" & _
  169.         Str$(GetDeviceCaps(hdc, NUMBRUSHES)) & _
  170.         "." & vbCrLf
  171.     txt = txt & "Device colors:" & _
  172.         Str$(GetDeviceCaps(hdc, NUMCOLORS)) & _
  173.         "." & vbCrLf
  174.     txt = txt & "Device fonts:" & _
  175.         Str$(GetDeviceCaps(hdc, NUMFONTS)) & _
  176.         "." & vbCrLf
  177.     txt = txt & "Device markers:" & _
  178.         Str$(GetDeviceCaps(hdc, NUMMARKERS)) & _
  179.         "." & vbCrLf
  180.     txt = txt & "Device pens:" & _
  181.         Str$(GetDeviceCaps(hdc, NUMPENS)) & _
  182.         "." & vbCrLf
  183.     ' See if the screen supports palettes.
  184.     rascaps = GetDeviceCaps(hdc, RASTERCAPS)
  185.     If rascaps And RC_PALETTE Then
  186.         txt = txt & "This device supports palettes." & vbCrLf
  187.         
  188.         ' See how big the system palette is.
  189.         sys_pal_size = GetDeviceCaps(hdc, SIZEPALETTE)
  190.         txt = txt & "The system palette holds" & _
  191.             Str$(sys_pal_size) & " entries." & _
  192.             vbCrLf
  193.         
  194.         ' See how many static colors there are.
  195.         num_static = GetDeviceCaps(hdc, NUMRESERVED)
  196.         txt = txt & "There are" & Str$(num_static) & _
  197.             " static colors." & vbCrLf
  198.         
  199.         ' Give the indexes of the static colors.
  200.         txt = txt & "The static colors are in system palette entries: 0-" & _
  201.             Format$(num_static \ 2 - 1) & " and " & _
  202.             Format$(sys_pal_size - num_static \ 2) & _
  203.             "-" & Format$(sys_pal_size - 1) & _
  204.             "." & vbCrLf
  205.         ' Get the color resolution.
  206.         clrres = GetDeviceCaps(hdc, COLORRES)
  207.         txt = txt & "The color resolution is" & _
  208.             Str$(clrres) & " bits per pixel (" & _
  209.             Format$(2 ^ clrres) & _
  210.             " possible values)." & vbCrLf
  211.         ' Get RASTERCAPS values.
  212.         txt = txt & "This device supports the following raster features:" & _
  213.             vbCrLf
  214.         If rascaps And RC_BANDING Then _
  215.             txt = txt & "    Banding." & vbCrLf
  216.         If rascaps And RC_BIGFONT Then _
  217.             txt = txt & "    Fonts bigger than 64K." & vbCrLf
  218.         If rascaps And RC_BITBLT Then _
  219.             txt = txt & "    Bitmap transfer." & vbCrLf
  220.         If rascaps And RC_BITMAP64 Then _
  221.             txt = txt & "    Bitmaps bigger than 64K." & vbCrLf
  222.         If rascaps And RC_DI_BITMAP Then _
  223.             txt = txt & "    The SetDIBits and GetDIBits functions." & vbCrLf
  224.         If rascaps And RC_DIBTODEV Then _
  225.             txt = txt & "    The SetDIBitsToDevice function." & vbCrLf
  226.         If rascaps And RC_FLOODFILL Then _
  227.             txt = txt & "    Flood fills." & vbCrLf
  228.         If rascaps And RC_GDI20_OUTPUT Then _
  229.             txt = txt & "    Windows 2.0 features." & vbCrLf
  230.         If rascaps And RC_PALETTE Then _
  231.             txt = txt & "    Palettes." & vbCrLf
  232.         If rascaps And RC_SCALING Then _
  233.             txt = txt & "    Scaling." & vbCrLf
  234.         If rascaps And RC_STRETCHBLT Then _
  235.             txt = txt & "    The StretchBlt function." & vbCrLf
  236.         If rascaps And RC_STRETCHDIB Then _
  237.             txt = txt & "    The StretchDIBits function." & vbCrLf
  238.             
  239.         ' Get CURVECAPS values.
  240.         curves = GetDeviceCaps(hdc, CURVECAPS)
  241.         txt = txt & "This device supports the following curve features:" & _
  242.             vbCrLf
  243.         If curves And CC_CHORD Then _
  244.             txt = txt & "    Chords." & vbCrLf
  245.         If curves And CC_CIRCLES Then _
  246.             txt = txt & "    Circles." & vbCrLf
  247.         If curves And CC_ELLIPSES Then _
  248.             txt = txt & "    Ellipses." & vbCrLf
  249.         If curves And CC_INTERIORS Then _
  250.             txt = txt & "    Interiors." & vbCrLf
  251.         If curves And CC_PIE Then _
  252.             txt = txt & "    Pie slices." & vbCrLf
  253.         If curves And CC_STYLED Then _
  254.             txt = txt & "    Line styles." & vbCrLf
  255.         If curves And CC_WIDE Then _
  256.             txt = txt & "    Wide lines." & vbCrLf
  257.         If curves And CC_WIDESTYLED Then _
  258.             txt = txt & "    Wide styled lines." & vbCrLf
  259.         ' Get LINECAPS values.
  260.         lines = GetDeviceCaps(hdc, LINECAPS)
  261.         txt = txt & "This device supports the following line features:" & _
  262.             vbCrLf
  263.         If lines And LC_INTERIORS Then _
  264.             txt = txt & "    Interiors." & vbCrLf
  265.         If lines And LC_MARKER Then _
  266.             txt = txt & "    Markers." & vbCrLf
  267.         If lines And LC_POLYLINE Then _
  268.             txt = txt & "    Polyline." & vbCrLf
  269.         If lines And LC_POLYMARKER Then _
  270.             txt = txt & "    Polymarkers." & vbCrLf
  271.         If lines And LC_STYLED Then _
  272.             txt = txt & "    Styled lines." & vbCrLf
  273.         If lines And LC_WIDE Then _
  274.             txt = txt & "    Wide lines." & vbCrLf
  275.         If lines And LC_WIDESTYLED Then _
  276.             txt = txt & "    Wide styled lines." & vbCrLf
  277.         ' Get POLYGONALCAPS values.
  278.         poly = GetDeviceCaps(hdc, POLYGONALCAPS)
  279.         txt = txt & "This device supports the following polygon features:" & _
  280.             vbCrLf
  281.         If lines And PC_INTERIORS Then _
  282.             txt = txt & "    Interiors." & vbCrLf
  283.         If lines And PC_POLYGON Then _
  284.             txt = txt & "    Alternate filled polygons." & vbCrLf
  285.         If lines And PC_RECTANGLE Then _
  286.             txt = txt & "    Rectangles." & vbCrLf
  287.         If lines And PC_SCANLINE Then _
  288.             txt = txt & "    Scan lines." & vbCrLf
  289.         If lines And PC_STYLED Then _
  290.             txt = txt & "    Styled borders." & vbCrLf
  291.         If lines And PC_WIDE Then _
  292.             txt = txt & "    Wide borders." & vbCrLf
  293.         If lines And PC_WIDESTYLED Then _
  294.             txt = txt & "    Wide styled borders." & vbCrLf
  295.         If lines And PC_WINDPOLYGON Then _
  296.             txt = txt & "    Winding number filled polygons." & vbCrLf
  297.         ' Get TEXTCAPS values.
  298.         text = GetDeviceCaps(hdc, TEXTCAPS)
  299.         txt = txt & "This device supports the following text features:" & _
  300.             vbCrLf
  301.         If lines And TC_CP_STROKE Then _
  302.             txt = txt & "    Stroke clip precision." & vbCrLf
  303.         If lines And TC_CR_90 Then _
  304.             txt = txt & "    Characters rotated 90 degrees." & vbCrLf
  305.         If lines And TC_CR_ANY Then _
  306.             txt = txt & "    Characters rotated through any angle." & vbCrLf
  307.         If lines And TC_EA_DOUBLE Then _
  308.             txt = txt & "    Double weight fonts (bold)." & vbCrLf
  309.         If lines And TC_IA_ABLE Then _
  310.             txt = txt & "    Italics." & vbCrLf
  311.         If lines And TC_OP_CHARACTER Then _
  312.             txt = txt & "    Character output precision." & vbCrLf
  313.         If lines And TC_OP_STROKE Then _
  314.             txt = txt & "    Stroke output precision." & vbCrLf
  315.         If lines And TC_RA_ABLE Then _
  316.             txt = txt & "    Raster fonts." & vbCrLf
  317.         If lines And TC_SA_CONTIN Then _
  318.             txt = txt & "    Fonts scaled by any factor." & vbCrLf
  319.         If lines And TC_SA_DOUBLE Then _
  320.             txt = txt & "    Font scaled by a factor of 2." & vbCrLf
  321.         If lines And TC_SA_INTEGER Then _
  322.             txt = txt & "    Fonts scaled by integer multiples." & vbCrLf
  323.         If lines And TC_SF_X_YINDEP Then _
  324.             txt = txt & "    Fonts scaled in the X and Y directions independently." & vbCrLf
  325.         If lines And TC_SO_ABLE Then _
  326.             txt = txt & "    Strikeout." & vbCrLf
  327.         If lines And TC_UA_ABLE Then _
  328.             txt = txt & "    Underline." & vbCrLf
  329.         If lines And TC_VA_ABLE Then _
  330.             txt = txt & "    Vector fonts." & vbCrLf
  331.     Else
  332.         txt = txt & "This device is not using palettes." & vbCrLf
  333.     End If
  334.     txtInfo.text = txt
  335. End Sub
  336. ' Make the text box as large as possible.
  337. Private Sub Form_Resize()
  338.     If WindowState = vbMinimized Then Exit Sub
  339.     txtInfo.Move 0, 0, ScaleWidth, ScaleHeight
  340. End Sub
  341.